Belgian Amiga Club - ADF Collection/BS1 part 26.zip/BS1 part 26/The Director Toolkit v1.0.adf/Programs/Text/docread

Text File | 1987-02-25 | 6KB | 300 lines

rem   text reader

    getok=1000:clears=1100:docmd=1200:getevent=1300

    font=1:clr=3
    charw=8
    charh=10
    cent=0
    styl=0
    spac=0
    esc=124        :rem  the | signal character
    xmax=610
    ymax=180
    xmin=20
    ymin=28
    eof=0

    load 1,"Toolkit:pictures/framer"    :rem  you may have to adjust this

    array 500,4
    temp=100
    pstart=temp+50
    page=pstart
    @(page)=0
    abort 0
    loadfont 1,8,"topaz.font"
    loadfont 2,9,"topaz.font"
    setfont font
    pen 1,clr
    margins xmin,xmax
    mode=0
    open mode,"docs"
    if mode=0
        center 1
        move 0,100
        pen 1,6
        setfont 2
        text "Can't open docs file"
        gosub getok
        end
    endif

rem   top of page
8
    location v
    @(page)=v    :rem  remember top of page
    page=page+1
    gosub clears

rem  next line
10    read v,$(0),90
    if v=-1:goto 22:endif
    in=0
    if @(in)=0        :rem  newline
        xloc=xmin
        yloc=yloc+charh
        if yloc > ymax
            gosub getevent
        endif
        goto 10
    endif

rem  proc any commands
11
    if @(in)=32:in=in+1:goto 11:endif :rem  ignore leading spaces
    if @(in)=0:goto 10:endif    :rem  eol
    if @(in)=esc
        gosub docmd
        goto 11
    endif

    word=in        :rem  beginning of section

rem  find end of section
12    c=@(in)
    if c#esc & c#0
        in=in+1
        goto 12
    endif
    @(in)=0

rem  proc section
13
    if @(in-1)=32    :rem  ignore trailing spaces
        @(in)=c
        in=in-1
        c=@(in)
        @(in)=0
        goto 13
    endif

    sectw=(charw+spac)*(in-word)

rem  output a section
    if (xloc+sectw)<xmax
        sp=1
        t=@(in-1)
        if t=46 | t=33 | t=63        :rem  . ! ?
            sp=2
        endif
        t=(xmax-(xloc+sectw))/(charw+spac)
        sp=sp_t
        center cent
        move xloc,yloc
        pen 1,clr
        text $(word);
        xloc=xloc+sectw+sp*(charw+spac)
        if cent            :rem  centering forces newline
            xloc=xmin
            yloc=yloc+charh
            if yloc > ymax
                gosub getevent
            endif
        endif
        center 0
        @(in)=c        :rem restore terminator
        goto 11
    endif

rem  section's too big, find subsection
    t=0~((xmax-xloc)/(charw+spac)-1)        :rem  compute max chars

14    if t=0            :rem  too near end of line
        yloc=yloc+charh
        if yloc > ymax
            gosub getevent
        endif
        xloc=xmin
        goto 13        :rem  retry this section on next line
    endif
    if @(word+t)#32        :rem  find word break
        t=t-1
        goto 14        :rem  keep moving
    endif

rem  found space break
    @(in)=c
    in=word+t
    c=@(in)
    @(in)=0
    goto 13        :rem  process shortened section

rem  getok
1000
    center 0
    pen 1,7
    move 306,154
    setfont 1
    text "OK"
    pen 1,4
    move 295,145
    draw 295,157
    draw 332,157
    draw 332,145
    draw 295,145
1001
    getmouse x,y
    if x>295 & x<332 & y>145 & y<157
        pen 1,0
        rect 295,145,332,157
        return
    else
        drawmode 2
        pen 1,7
        rect 295,145,332,157:pause 1
        rect 295,145,332,157
        goto 1001
    endif
    setfont font
    return

rem  clears
1100
    xloc=xmin:yloc=ymin
    pen 1,0
    rect 5,17,633,182
    pen 1,clr
    return

rem  docmd
1200
    in=in+1
    @(temp+1)=0
    if @(in)=99        :rem  'c' for color
        in=in+2
        @(temp)=@(in-1)
        clr=$(temp)
        pen 1,clr
        return
    endif
    if @(in)=102    :rem  'f' for font
        in=in+2
        @(temp)=@(in-1)
        font=$(temp)
        setfont font
        if font=2
            charw=10
        else
            charw=8
        endif
        return
    endif
    if @(in)=116    :rem   't' for centering
        in=in+2
        @(temp)=@(in-1)
        cent=$(temp)
        return
    endif
    if @(in)=114    :rem  'r' for forced return
        in=in+2
        @(temp)=@(in-1)
        rets=$(temp)
        xloc=xmin
        yloc=yloc+charh*rets
        if yloc > ymax
            gosub getevent
        endif
        return
    endif
    if @(in)=115    :rem  's' for style
        in=in+3
        @(temp)=@(in-2)
        styl=$(temp)
        @(temp)=@(in-1)
        spac=$(temp)
        style styl,spac
        return
    endif
    if @(in)=101    :rem  'e' for end of page
        in=in+1
        goto getevent        :rem  await page click
    endif
    if @(in)=esc    :rem  use || to output a |
        in=in+1
        move xloc,yloc
        text "|";
        sps=1
        goto 1222    :rem  act like space from here
    endif
    if @(in)=45        :rem  '-' for backspace
        in=in+1
        xloc=(xloc-charw)~xmin
        return
    endif
    if @(in)=43        :rem  '+' for required spaces
        in=in+2
        @(temp)=@(in-1)
        sps=$(temp)
        if sps=0:sps=10:endif
1222
        xloc=xloc+charw*sps
        if xloc>xmax
            xloc=xmin
            yloc=yloc+charh
            if yloc > ymax
                gosub getevent
            endif
        endif
        return
    endif
    return

rem  eof  -  handle backup from here as well
22    eof=1
    gosub getevent
    goto 10        :rem  next line

rem  getevent
1300
    getmouse x,y

rem  quit box...
    if x>9 & x<22 & y>4 & y<9
        end
    endif

rem  bkwd page
    if x>243 & x<301 & y>184 & y<197
        page=(page-2)~pstart
        seek @(page)
        page=page+1
        eof=0
        gosub clears
        return
    endif

    if eof
        eof=0
        return
    endif

rem  fwd page
    location v
    @(page)=v    :rem  remember top of page location
    page=page+1
    gosub clears
    return